home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Especial Multimedia
/
Especial Multimedia.iso
/
Multimed
/
Prg
/
KALENDAR.ZIP
/
TEST5.FRM
< prev
Wrap
Text File
|
1997-09-14
|
6KB
|
194 lines
VERSION 2.00
Begin Form Form5
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Schedule Kalendar"
ClientHeight = 4230
ClientLeft = 3225
ClientTop = 630
ClientWidth = 6030
ForeColor = &H00000000&
Height = 4920
Left = 3165
LinkTopic = "Form5"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4230
ScaleWidth = 6030
Top = 0
Width = 6150
Begin Kalendar Kalendar1
ArrowDelay = 500
BackColor = &H00FFFFFF&
CalendarFormat = 0 'Month
ChgOnOtherMon = -1 'True
DateDispStyle = 2 'User
DayAlignment = 0 'Upper Left
DOWAlign = 2 'Center
DOWBackColor = &H00008000&
DOWBorder = -1 'True
DOWDispStyle = 2 'Medium
DOWFontBold = -1 'True
DOWFontItalic = 0 'False
DOWFontName = "Arial"
DOWFontSize = 10
DOWFontStrikeThru= 0 'False
DOWFontUnderline= 0 'False
DOWForeColor = &H00FFFFFF&
EnableKeys = -1 'True
FirstDOW = 0 'Sunday
FixedDayHeight = 0 'False
FontBold = -1 'True
FontItalic = -1 'True
FontName = "Arial"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 4230
Language = 0 'English
Left = 30
LineColor = &H00000000&
MonAlign = 2 'Center
MonBackColor = &H00FFFFFF&
MonDispStyle = 2 'Month/Year
MonFontBold = 0 'False
MonFontItalic = 0 'False
MonFontName = "Times New Roman"
MonFontSize = 14
MonFontStrikeThru= 0 'False
MonFontUnderline= 0 'False
MonForeColor = &H00000000&
OtherMonBackColor= &H00FFFFFF&
OtherMonForeColor= &H00C0C0C0&
SelDayBackColor = &H00FF00FF&
SelDayForeColor = &H0000FFFF&
ShowAllDays = -1 'True
ShowArrows = -1 'True
ShowLines = -1 'True
ShowSelection = -1 'True
TabIndex = 0
Text = "07/02/94"
TextFormat = 0 'mdy
Top = 0
Width = 6000
End
Begin Menu mnuFile
Caption = "&File"
Begin Menu mnuFPrint
Caption = "Print &Portrait"
End
Begin Menu mnuFPrintLand
Caption = "Print &Landscape"
End
Begin Menu mnuFPrint3by3
Caption = "Print 3"" X 3"""
End
End
End
Option Explicit
Sub Form_Activate ()
SetDescription Sample5Description()
End Sub
Sub Form_Load ()
Kalendar1.Text = Date
End Sub
Sub Form_Resize ()
Kalendar1.Move 0, 0, Form5.ScaleWidth, Form5.ScaleHeight
End Sub
Sub Kalendar1_ClickDay ()
Dim info As DateRange
If GetDateRangeInfo((Kalendar1.Julian), info) Then
Form5.Caption = info.Description
Else
Form5.Caption = ""
End If
End Sub
Sub Kalendar1_DrawOnDay (hDC As Integer, State As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single)
Dim info As DateRange
Dim r As Rect
Dim retval As Variant
Dim oldHBrush As Integer, hBrush As Integer, oldPen As Integer
If GetDateRangeInfo(theDay, info) Then
KalWindowAPIRect x, y, x2, y2, r
If info.StartDate = theDay Then
r.left = r.left + 20
End If
If info.EndDate = theDay Then
r.right = r.right - 20
End If
hBrush = CreateSolidBrush(info.color)
oldHBrush = SelectObject(hDC, hBrush)
oldPen = SelectObject(hDC, GetStockObject(NULL_PEN))
r.top = r.bottom - 8
r.bottom = r.bottom - 2
retval = Rectangle(hDC, r.left, r.top, r.right, r.bottom)
retval = SelectObject(hDC, oldPen)
retval = SelectObject(hDC, oldHBrush)
retval = DeleteObject(hBrush)
End If
End Sub
Sub mnuFPrint_Click ()
Kalendar1.PrintAction = KAL_PRINT_PORTRAIT
End Sub
Sub mnuFPrint3by3_Click ()
Dim SaveMonFontSize As Single
Dim saveBackColor As Long
Screen.MousePointer = 11
SaveMonFontSize = Kalendar1.MonFontSize
saveBackColor = Kalendar1.MonBackColor
Kalendar1.MonFontSize = 14
Kalendar1.MonFontBold = True
Kalendar1.BorderStyle = 1
Kalendar1.MonBackColor = RGB(255, 255, 255)
Kalendar1.PrintX = 2880
Kalendar1.PrintY = 2880
Kalendar1.PrintWidth = 1440 * 3
Kalendar1.PrintHeight = 1440 * 3
Kalendar1.PrintHDC = Printer.hDC
Printer.Print ' Necessary for VB to send STARTDOC, before printing the Kalendar.
Kalendar1.PrintAction = KAL_PRINT_USER
Kalendar1.MonFontBold = False
Kalendar1.MonFontSize = SaveMonFontSize
Kalendar1.MonBackColor = saveBackColor
Kalendar1.BorderStyle = 0
Printer.EndDoc
Screen.MousePointer = 0
End Sub
Sub mnuFPrintLand_Click ()
Kalendar1.PrintAction = KAL_PRINT_LANDSCAPE
End Sub
Function Sample5Description () As String
Dim s As String
s = "One more example of the DrawOnDay event." & CR
s = s & "You can also print this Kalendar using the three different methods available."
Sample5Description = s
End Function